home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / theloa1a / frmloade.frm (.txt) < prev    next >
Visual Basic Form  |  1999-10-13  |  10KB  |  215 lines
  1. VERSION 5.00
  2. Begin VB.Form frmAbout 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    ClientHeight    =   3555
  5.    ClientLeft      =   2340
  6.    ClientTop       =   1935
  7.    ClientWidth     =   5730
  8.    ClipControls    =   0   'False
  9.    LinkTopic       =   "Form2"
  10.    MaxButton       =   0   'False
  11.    MinButton       =   0   'False
  12.    ScaleHeight     =   2453.724
  13.    ScaleMode       =   0  'User
  14.    ScaleWidth      =   5380.766
  15.    ShowInTaskbar   =   0   'False
  16.    Begin VB.PictureBox picIcon 
  17.       AutoSize        =   -1  'True
  18.       ClipControls    =   0   'False
  19.       Height          =   540
  20.       Left            =   240
  21.       Picture         =   "frmLoaderAbout.frx":0000
  22.       ScaleHeight     =   337.12
  23.       ScaleMode       =   0  'User
  24.       ScaleWidth      =   337.12
  25.       TabIndex        =   1
  26.       Top             =   240
  27.       Width           =   540
  28.    End
  29.    Begin VB.CommandButton cmdOK 
  30.       Cancel          =   -1  'True
  31.       Caption         =   "OK"
  32.       Default         =   -1  'True
  33.       Height          =   345
  34.       Left            =   4245
  35.       TabIndex        =   0
  36.       Top             =   2625
  37.       Width           =   1260
  38.    End
  39.    Begin VB.Line Line1 
  40.       BorderColor     =   &H00808080&
  41.       BorderStyle     =   6  'Inside Solid
  42.       Index           =   1
  43.       X1              =   84.515
  44.       X2              =   5309.398
  45.       Y1              =   1687.583
  46.       Y2              =   1687.583
  47.    End
  48.    Begin VB.Label lblDescription 
  49.       Caption         =   $"frmLoaderAbout.frx":0442
  50.       ForeColor       =   &H00000000&
  51.       Height          =   1170
  52.       Left            =   1050
  53.       TabIndex        =   2
  54.       Top             =   1125
  55.       Width           =   3885
  56.    End
  57.    Begin VB.Label lblTitle 
  58.       Alignment       =   2  'Center
  59.       Caption         =   "The Loader"
  60.       BeginProperty Font 
  61.          Name            =   "PosterBodoni BT"
  62.          Size            =   15.75
  63.          Charset         =   0
  64.          Weight          =   400
  65.          Underline       =   0   'False
  66.          Italic          =   0   'False
  67.          Strikethrough   =   0   'False
  68.       EndProperty
  69.       ForeColor       =   &H00000000&
  70.       Height          =   480
  71.       Left            =   1050
  72.       TabIndex        =   4
  73.       Top             =   240
  74.       Width           =   3885
  75.    End
  76.    Begin VB.Line Line1 
  77.       BorderColor     =   &H00FFFFFF&
  78.       BorderWidth     =   2
  79.       Index           =   0
  80.       X1              =   98.6
  81.       X2              =   5309.398
  82.       Y1              =   1697.936
  83.       Y2              =   1697.936
  84.    End
  85.    Begin VB.Label lblVersion 
  86.       Caption         =   "Version:1.0.1"
  87.       Height          =   225
  88.       Left            =   1050
  89.       TabIndex        =   5
  90.       Top             =   780
  91.       Width           =   3885
  92.    End
  93.    Begin VB.Label lblDisclaimer 
  94.       Caption         =   "Warning: ... hmmm"
  95.       ForeColor       =   &H00000000&
  96.       Height          =   825
  97.       Left            =   255
  98.       TabIndex        =   3
  99.       Top             =   2640
  100.       Width           =   3870
  101.    End
  102. Attribute VB_Name = "frmAbout"
  103. Attribute VB_GlobalNameSpace = False
  104. Attribute VB_Creatable = False
  105. Attribute VB_PredeclaredId = True
  106. Attribute VB_Exposed = False
  107. Option Explicit
  108. ' Reg Key Security Options...
  109. Const READ_CONTROL = &H20000
  110. Const KEY_QUERY_VALUE = &H1
  111. Const KEY_SET_VALUE = &H2
  112. Const KEY_CREATE_SUB_KEY = &H4
  113. Const KEY_ENUMERATE_SUB_KEYS = &H8
  114. Const KEY_NOTIFY = &H10
  115. Const KEY_CREATE_LINK = &H20
  116. Const KEY_ALL_ACCESS = KEY_QUERY_VALUE + KEY_SET_VALUE + _
  117.                        KEY_CREATE_SUB_KEY + KEY_ENUMERATE_SUB_KEYS + _
  118.                        KEY_NOTIFY + KEY_CREATE_LINK + READ_CONTROL
  119.                      
  120. ' Reg Key ROOT Types...
  121. Const HKEY_LOCAL_MACHINE = &H80000002
  122. Const ERROR_SUCCESS = 0
  123. Const REG_SZ = 1                         ' Unicode nul terminated string
  124. Const REG_DWORD = 4                      ' 32-bit number
  125. Const gREGKEYSYSINFOLOC = "SOFTWARE\Microsoft\Shared Tools Location"
  126. Const gREGVALSYSINFOLOC = "MSINFO"
  127. Const gREGKEYSYSINFO = "SOFTWARE\Microsoft\Shared Tools\MSINFO"
  128. Const gREGVALSYSINFO = "PATH"
  129. Private Declare Function RegOpenKeyEx Lib "advapi32" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
  130. Private Declare Function RegQueryValueEx Lib "advapi32" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByVal lpData As String, ByRef lpcbData As Long) As Long
  131. Private Declare Function RegCloseKey Lib "advapi32" (ByVal hKey As Long) As Long
  132. Private Sub cmdSysInfo_Click()
  133.   Call StartSysInfo
  134. End Sub
  135. Private Sub cmdOK_Click()
  136.   Unload Me
  137. End Sub
  138. Private Sub Form_Load()
  139.     Me.Caption = "About " & App.Title
  140.     lblVersion.Caption = "Version " & App.Major & "." & App.Minor & "." & App.Revision
  141.     lblTitle.Caption = App.Title
  142. End Sub
  143. Public Sub StartSysInfo()
  144.     On Error GoTo SysInfoErr
  145.     Dim rc As Long
  146.     Dim SysInfoPath As String
  147.     ' Try To Get System Info Program Path\Name From Registry...
  148.     If GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFO, gREGVALSYSINFO, SysInfoPath) Then
  149.     ' Try To Get System Info Program Path Only From Registry...
  150.     ElseIf GetKeyValue(HKEY_LOCAL_MACHINE, gREGKEYSYSINFOLOC, gREGVALSYSINFOLOC, SysInfoPath) Then
  151.         ' Validate Existance Of Known 32 Bit File Version
  152.         If (Dir(SysInfoPath & "\MSINFO32.EXE") <> "") Then
  153.             SysInfoPath = SysInfoPath & "\MSINFO32.EXE"
  154.             
  155.         ' Error - File Can Not Be Found...
  156.         Else
  157.             GoTo SysInfoErr
  158.         End If
  159.     ' Error - Registry Entry Can Not Be Found...
  160.     Else
  161.         GoTo SysInfoErr
  162.     End If
  163.     Call Shell(SysInfoPath, vbNormalFocus)
  164.     Exit Sub
  165. SysInfoErr:
  166.     MsgBox "System Information Is Unavailable At This Time", vbOKOnly
  167. End Sub
  168. Public Function GetKeyValue(KeyRoot As Long, KeyName As String, SubKeyRef As String, ByRef KeyVal As String) As Boolean
  169.     Dim i As Long                                           ' Loop Counter
  170.     Dim rc As Long                                          ' Return Code
  171.     Dim hKey As Long                                        ' Handle To An Open Registry Key
  172.     Dim hDepth As Long                                      '
  173.     Dim KeyValType As Long                                  ' Data Type Of A Registry Key
  174.     Dim tmpVal As String                                    ' Tempory Storage For A Registry Key Value
  175.     Dim KeyValSize As Long                                  ' Size Of Registry Key Variable
  176.     '------------------------------------------------------------
  177.     ' Open RegKey Under KeyRoot {HKEY_LOCAL_MACHINE...}
  178.     '------------------------------------------------------------
  179.     rc = RegOpenKeyEx(KeyRoot, KeyName, 0, KEY_ALL_ACCESS, hKey) ' Open Registry Key
  180.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Error...
  181.     tmpVal = String$(1024, 0)                             ' Allocate Variable Space
  182.     KeyValSize = 1024                                       ' Mark Variable Size
  183.     '------------------------------------------------------------
  184.     ' Retrieve Registry Key Value...
  185.     '------------------------------------------------------------
  186.     rc = RegQueryValueEx(hKey, SubKeyRef, 0, _
  187.                          KeyValType, tmpVal, KeyValSize)    ' Get/Create Key Value
  188.                         
  189.     If (rc <> ERROR_SUCCESS) Then GoTo GetKeyError          ' Handle Errors
  190.     If (Asc(Mid(tmpVal, KeyValSize, 1)) = 0) Then           ' Win95 Adds Null Terminated String...
  191.         tmpVal = Left(tmpVal, KeyValSize - 1)               ' Null Found, Extract From String
  192.     Else                                                    ' WinNT Does NOT Null Terminate String...
  193.         tmpVal = Left(tmpVal, KeyValSize)                   ' Null Not Found, Extract String Only
  194.     End If
  195.     '------------------------------------------------------------
  196.     ' Determine Key Value Type For Conversion...
  197.     '------------------------------------------------------------
  198.     Select Case KeyValType                                  ' Search Data Types...
  199.